home *** CD-ROM | disk | FTP | other *** search
- unit Mmblob;
-
- interface
-
- uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
- StdCtrls, ExtCtrls, MPlayer, DB, DBTables, DBCtrls, Gauges, SysUtils,
- Dialogs, Mask, TDBMulti;
-
- type
- TBtnBottomDlg = class(TForm)
- CancelBtn: TBitBtn;
- DBMediaPlayer1: TDBMediaPlayer;
- DataSource1: TDataSource;
- Table1: TTable;
- DBNavigator1: TDBNavigator;
- Gauge1: TGauge;
- OpenDialog1: TOpenDialog;
- BitBtn1: TBitBtn;
- CheckBox1: TCheckBox;
- CheckBox2: TCheckBox;
- OpenDialog2: TOpenDialog;
- BitBtn2: TBitBtn;
- DBMultiMedia1: TDBMultiMedia;
- DBEdit1: TDBEdit;
- DBEdit2: TDBEdit;
- DBMemo1: TDBMemo;
- Label1: TLabel;
- BitBtn3: TBitBtn;
- CheckBox3: TCheckBox;
- CheckBox4: TCheckBox;
- Label2: TLabel;
- Label3: TLabel;
- Label5: TLabel;
- Label6: TLabel;
- Label7: TLabel;
- Label4: TLabel;
- Bevel1: TBevel;
- Label8: TLabel;
- Label9: TLabel;
- procedure CancelBtnClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure BitBtn1Click(Sender: TObject);
- procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
- procedure DBMediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
- var DoDefault: Boolean);
- procedure CheckBox1Click(Sender: TObject);
- procedure CheckBox2Click(Sender: TObject);
- procedure BitBtn2Click(Sender: TObject);
- procedure BitBtn3Click(Sender: TObject);
- procedure CheckBox3Click(Sender: TObject);
- procedure CheckBox4Click(Sender: TObject);
- private
- function JustPathname(PathName : string) : string;
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- BtnBottomDlg: TBtnBottomDlg;
-
- implementation
-
- {$R *.DFM}
-
- procedure TBtnBottomDlg.CancelBtnClick(Sender: TObject);
- begin
- {close the app}
- close;
- end;
-
- procedure IwillBeCalled ( i : integer); export;
- {Call back function. MUST be exported otherwise the DLL can't find it}
- begin
- {Process Progress bar}
- BtnBottomDlg.Gauge1.Progress:=i;
-
- {Live in peace with others}
- Application.ProcessMessages;
- end;
-
- procedure TBtnBottomDlg.FormCreate(Sender: TObject);
- begin
- {Register the callback Fuction to the VCL}
- TDBMultiMediaCallBack:=IwillBeCalled;
-
- {init label caption with file type}
- Label1.Caption:=DBMultiMedia1.BFiletype;
-
- {init label caption with file size}
- Label2.Caption:=IntToStr(DBMultiMedia1.Bsize);
-
- {On/Off Play the multimedia automatically}
- DBMultiMedia1.AutoPlayMultiMedia:=CheckBox1.Checked;
-
- {On/Off Hide the DBMediaPlayer Automatically if MM is present}
- DBMultiMedia1.AutoHideMediaPlayer:=CheckBox2.Checked;
-
- {On/Off RePlay the multimedia automatically}
- DBMultiMedia1.AutoRePlayMultiMedia:=CheckBox4.Checked;
-
- {On/Off Display the multimedia automatically}
- DBMultiMedia1.AutoDisplay:=CheckBox3.Checked;
- end;
-
-
- procedure TBtnBottomDlg.BitBtn1Click(Sender: TObject);
- begin
- {fill the OpenDialog filter with the MM extensions as found in the win.ini
- (This means that the appropriate drivers are installed)}
- OpenDialog1.filter:=DBMultiMedia1.GetMultiMediaExtensions;
-
- {Execute the open dialog box}
- if OpenDialog1.Execute then begin
-
- {Place the Database in append mode}
- Table1.Append;
-
- {Load the Multimedia into the Blob}
- DBMultiMedia1.LoadfromFile(OpenDialog1.FileName);
-
- {Post that thing}
- Table1.Post;
- end;
-
- end;
-
- procedure TBtnBottomDlg.BitBtn3Click(Sender: TObject);
- begin
- {fill the OpenDialog filter with the MM extensions as found in the win.ini
- (This means that the appropriate drivers are installed)}
- OpenDialog1.filter:=DBMultiMedia1.GetMultiMediaExtensions;
-
- {Execute the open dialog box}
- if OpenDialog1.Execute then begin
-
- {Place the Database in edit mode}
- Table1.Edit;
-
- {Load the Multimedia into the Blob}
- DBMultiMedia1.LoadfromFile(OpenDialog1.FileName);
-
- {Post that thing}
- Table1.Post;
- end;
-
- end;
-
-
- procedure TBtnBottomDlg.DBNavigator1Click(Sender: TObject;
- Button: TNavigateBtn);
- begin
- {Set the blob window to visible}
- DBMultiMedia1.Visible:=true;
-
- {Set the Video display rectangle to the rectangle of the blob window}
- DBMediaPlayer1.DisplayRect:=Rect(0,0,DBMultiMedia1.Width,DBMultiMedia1.Height);
-
- {Set the Video display to the the display of the blob window}
- DBMediaPlayer1.Display:=DBMultiMedia1;
-
-
- {init label caption with file type}
- Label1.Caption:=DBMultiMedia1.BFiletype;
-
- {init label caption with file size}
- Label2.Caption:=IntToStr(DBMultiMedia1.Bsize);
-
- {Suprise <g>}
- if (Label1.Caption = 'MID') or (Label1.Caption = 'RMI') or (Label1.Caption = 'WAV') then
- {hide blob window if no media needs to be display and auto hide is on}
- DBMultiMedia1.Visible:=not CheckBox2.Checked;
- end;
-
- procedure TBtnBottomDlg.DBMediaPlayer1Click(Sender: TObject;
- Button: TMPBtnType; var DoDefault: Boolean);
- begin
- {Set the Video display rectangle to the rectangle of the blob window}
- DBMediaPlayer1.DisplayRect:=Rect(0,0,DBMultiMedia1.Width,DBMultiMedia1.Height);
-
- {Set the Video display to the the display of the blob window}
- DBMediaPlayer1.Display:=DBMultiMedia1;
-
- {init label caption with file type}
- Label1.Caption:=DBMultiMedia1.BFiletype;
-
- {init label caption with file size}
- Label2.Caption:=IntToStr(DBMultiMedia1.Bsize);
-
- {Suprise <g>}
- if (Label1.Caption = 'MID') or (Label1.Caption = 'RMI') or (Label1.Caption = 'WAV') then
- {hide blob window if no media needs to be display and auto hide is on}
- DBMultiMedia1.Visible:=not CheckBox2.Checked;
- end;
-
-
- procedure TBtnBottomDlg.CheckBox1Click(Sender: TObject);
- begin
- {Play the appropriate multimedi when there}
- DBMultiMedia1.AutoPlayMultiMedia:=CheckBox1.Checked;
- end;
-
- procedure TBtnBottomDlg.CheckBox2Click(Sender: TObject);
- begin
- {On/Off Hide the DBMediaPlayer Automatically if MM is present}
- DBMultiMedia1.AutoHideMediaPlayer:=CheckBox2.Checked;
-
- {Suprise <g>}
- if (Label1.Caption = 'MID') or (Label1.Caption = 'RMI') or (Label1.Caption = 'WAV') then
- {hide blob window if no media needs to be display and auto hide is on}
- DBMultiMedia1.Visible:=not CheckBox2.Checked;
- end;
-
- procedure TBtnBottomDlg.CheckBox3Click(Sender: TObject);
- begin
- {On/Off Display the multimedia automatically}
- DBMultiMedia1.AutoDisplay:=CheckBox3.Checked;
- end;
-
- procedure TBtnBottomDlg.CheckBox4Click(Sender: TObject);
- begin
- {On/Off RePlay the multimedia automatically}
- DBMultiMedia1.AutoRePlayMultiMedia:=CheckBox4.Checked;
- end;
-
-
- function TBtnBottomDlg.JustPathname(PathName : string) : string;
- {-Return just the drive:directory portion of a pathname}
- var
- I : Word;
- const
- DosDelimSet : set of Char = ['\', ':', #0];
- begin
- I := Succ(Word(Length(PathName)));
- repeat
- Dec(I);
- until (PathName[I] in DosDelimSet) or (I = 0);
-
- if I = 0 then
- {Had no drive or directory name}
- JustPathname[0] := #0
- else if I = 1 then
- {Either the root directory of default drive or invalid pathname}
- JustPathname := PathName[1]
- else if (PathName[I] = '\') then begin
- if PathName[Pred(I)] = ':' then
- {Root directory of a drive, leave trailing backslash}
- JustPathname := Copy(PathName, 1, I)
- else
- {Subdirectory, remove the trailing backslash}
- JustPathname := Copy(PathName, 1, Pred(I));
- end else
- {Either the default directory of a drive or invalid pathname}
- JustPathname := Copy(PathName, 1, I);
- end;
-
-
- procedure TBtnBottomDlg.BitBtn2Click(Sender: TObject);
- begin
- {open the table}
- try
- If OpenDialog2.execute then begin
- Table1.Active:=False;
- Table1.DataBaseName:=JustPathname(OpenDialog2.FileName);
- Table1.TableName:=OpenDialog2.FileName;
- Table1.Active:=True;
- end;
- finally
- {Show or hide the append/replace button, depending on
- the table active stasus}
- BitBtn3.Enabled:=Table1.Active;
- BitBtn1.Enabled:=Table1.Active;
- end;
- end;
-
-
- {easy enough ?}
-
- end.
-